home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 6 / 006.d81 / visible bubble s (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  14KB  |  560 lines
  1. 10 rem ********************************
  2. 20 rem *       v i s i b l e          *
  3. 30 rem *   b u b b l e  s o r t       *
  4. 40 rem *                              *
  5. 50 rem *    by: thomas g. pink        *
  6. 60 rem *                              *
  7. 70 rem *  revised for the c-64 by:    *
  8. 80 rem *       alan w. gardner        *
  9. 90 rem *           8/84               *
  10. 95 rem ********************************
  11. 100 :
  12. 110 rem a$()array of words to sort
  13. 115 rem h   horizontal tab
  14. 120 rem k   for-next counter
  15. 125 rem l   length of string to center
  16. 130 rem m   number of menu items
  17. 135 rem m$()menu array
  18. 140 rem mt$ menu title
  19. 145 rem n   number of words in sort ary
  20. 150 rem p   for-next counter for pause
  21. 155 rem p$()array for program lines
  22. 160 rem pa  pause factor
  23. 165 rem pfl flag to see/not program
  24. 170 rem r   for-next counter in movers
  25. 175 rem st$ temp. storage string
  26. 180 rem tfl flag for speed(pauses)
  27. 185 rem v   vertical tab
  28. 190 rem vfl flag to see/not visual sort
  29. 195 rem w$  column heading
  30. 200 rem x$  string used in centering
  31. 202 rem ss  address to position cursor
  32. 205 :
  33. 210 rem *******************************
  34. 220 rem *                             *
  35. 230 rem *   m a i n  p r o g r a m    *
  36. 240 rem *                             *
  37. 250 rem *******************************
  38. 255 :
  39. 260 print"[147]":ss=65520:poke783,peek(783)and254
  40. 270 dim m$(4),a$(10),b$(10),p$(8)
  41. 280 gosub 3540:  rem   credits
  42. 290 gosub 3250:  rem   read menu - m$()
  43. 300 gosub 3340:  rem   read sort - b$()
  44. 310 gosub 3400:  rem   read prg array
  45. 320 gosub 2720:  rem   menu
  46. 330 gosub 2190:  rem   sort
  47. 340 goto 320:  (NULL) back to menu
  48. 350 :
  49. 360 rem *******************************
  50. 370 rem *                             *
  51. 380 rem *   end  of  main  program    *
  52. 390 rem *                             *
  53. 400 rem *******************************
  54. 405 :
  55. 410 rem *******************************
  56. 420 rem *                             *
  57. 430 rem *    u s e r  p a u s e       *
  58. 440 rem *                             *
  59. 450 rem *******************************
  60. 455 :
  61. 460 ifpeek(198)<=0then475
  62. 465 poke198,0
  63. 470 wait198,1:poke198,0
  64. 475 return
  65. 480 :
  66. 490 rem *******************************
  67. 495 rem *                             *
  68. 500 rem *  move sub-i to storage      *
  69. 505 rem *                             *
  70. 510 rem *******************************
  71. 515 :
  72. 520 if pfl=1thenprint"":poke781,20:poke782,1:sysss:print""p$(4)"[146]"
  73. 525 print"[146]"
  74. 530 for r=8to39-len(a$(i))step1
  75. 535 ifr-8<len(a$(i))thenpoke781,v+i:poke782,8+len(a$(i)):sysss:printright$(a$(i),r-7);
  76. 540 ifr-8>=len(a$(i))thenpoke781,v+i:poke782,r-0:sysss:print" ";a$(i);
  77. 545 ifsfl=1thenc=1
  78. 550 iftfl<>0thenpa=2:gosub 1160: rem pause
  79. 555 gosub 390
  80. 560 next r
  81. 565 ifsfl=1thenc=5
  82. 570 iftfl<>0thenpa=10:gosub 1160: rem pause
  83. 575 ifpfl=1thenpoke781,20:poke782,1:sysss:printp$(4)
  84. 580 return
  85. 585 :
  86. 590 rem **   move sub-j to sub-i **
  87. 595 rem
  88. 600 ifpfl=1thenprint"":poke781,21:poke782,1:sysss:print""p$(5)"[146]"
  89. 602 iftfl<>0thenpa=50:gosub1160
  90. 604 forr=8to19
  91. 610 ifr-8<len(a$(j))thenpoke781,v+j:poke782,8+len(a$(j)):sysss:printright$(a$(j),r-7);
  92. 620 ifr-8>=len(a$(j))thenpoke781,v+j:poke782,r:sysss:print" ";a$(j);
  93. 630 ifsfl=1thenc=1
  94. 640 iftfl<>0thenpa=2:gosub1160
  95. 650 gosub 390
  96. 660 next r
  97. 670 ifsfl=1thenc=5
  98. 680 iftfl<>0thenpa=10:gosub 1160
  99. 690 forr=v+j-1tov+istep-1
  100. 700 poke781,r:poke782,20:sysss:printa$(j);
  101. 710 poke781,r+1:poke782,20:sysss:print"          ";
  102. 720 ifsfl=1thenc=1
  103. 730 iftfl<>0thenpa=2:gosub 1160
  104. 740 gosub 390
  105. 750 nextr
  106. 760 ifsfl=1thenc=5
  107. 770 iftfl<>0thenpa=10:gosub 1160
  108. 780 forr=19to8step-1
  109. 790 poke781,v+i:poke782,r:sysss:printa$(j);" ";
  110. 800 ifsfl=1thenc=1
  111. 810 iftfl<>0thenpa=2:gosub 1160
  112. 820 gosub 390
  113. 830 next r
  114. 840 ifsfl=1thenc=5
  115. 850 iftfl<>0thenpa=10:gosub 1160
  116. 860 ifpfl=1thenpoke781,21:poke782,1:sysss:printp$(5)
  117. 870 return
  118. 875 :
  119. 880 rem*******************************
  120. 882 rem*                             *
  121. 884 rem*   move storage to sub-j     *
  122. 886 rem*                             *
  123. 888 rem*******************************
  124. 889 :
  125. 890 ifpfl=1thenprint"":poke781,22:poke782,1:sysss:print""p$(6)"[146]"
  126. 900 iftfl<>0thenpa=50:gosub 1160
  127. 910 forr=v+i+1tov+j
  128. 920 poke781,r:poke782,40-len(st$):sysss:printst$
  129. 930 ifr>v+i+1thenpoke781,r-1:poke782,30:sysss:print"          ";
  130. 940 ifsfl=1thenc=1
  131. 950 iftfl<>0thenpa=2:gosub 1160
  132. 960 gosub 390
  133. 970 next r
  134. 980 ifsfl=1thenc=5
  135. 990 iftfl<>0thenpa=10:gosub 1160
  136. 1000 forr=40-len(st$)to8step-1
  137. 1010 poke781,v+j:poke782,r:sysss:printst$;" ";
  138. 1020 ifsfl=1thenc=1
  139. 1030 iftfl<>0thenpa=2:gosub1160
  140. 1040 gosub 390
  141. 1050 next r
  142. 1060 ifsfl=1thenc=5
  143. 1070 iftfl<>0thenpa=10:gosub1160
  144. 1080 ifpfl=1thenpoke781,22:poke782,1:sysss:printp$(6)
  145. 1090 return
  146. 1100 rem *****************************
  147. 1102 rem *                           *
  148. 1104 rem *    sound routine          *
  149. 1106 rem *                           *
  150. 1108 rem *****************************
  151. 1109 :
  152. 1110 rem    not implemented   (yet)
  153. 1150 rem *****************************
  154. 1152 rem *                           *
  155. 1154 rem *         pause             *
  156. 1156 rem *                           *
  157. 1158 rem *****************************
  158. 1159 :
  159. 1160 forp=1to (pa*tfl*5):nextp
  160. 1170 return
  161. 1175 :
  162. 1180 rem *****************************
  163. 1182 rem *                           *
  164. 1184 rem *       check is ok         *
  165. 1186 rem *                           *
  166. 1188 rem *****************************
  167. 1189 :
  168. 1190 ifvfl=0thengoto1270
  169. 1195 :
  170. 1200 iftfl<>0thenpa=25:gosub 1160
  171. 1210 poke781,v+j:poke782,20:sysss:print"ok[146]";
  172. 1220 rem   sound of the bell
  173. 1230 iftfl<>0thenpa=50:gosub 1160
  174. 1240 gosub 390
  175. 1250 ifpfl=1thenpoke781,19:poke782,1:sysss:print""p$(3)"[146]";
  176. 1260 poke781,v+j:poke782,20:sysss:print"  ";
  177. 1270 return
  178. 1275 :
  179. 1280 rem ******************************
  180. 1282 rem *                            *
  181. 1284 rem *        swap 'em            *
  182. 1286 rem *                            *
  183. 1288 rem ******************************
  184. 1289 :
  185. 1290 iftfl<>0thenpa=25:gosub 1160
  186. 1300 poke781,v+j:poke782,20:sysss:print"swap 'em[146]";
  187. 1310 ifsfl=1thenc=30
  188. 1320 iftfl<>0thenpa=50:gosub 1160
  189. 1330 gosub 390
  190. 1340 ifpfl=1thenpoke781,19:poke782,1:sysss:printp$(3)"[146]";
  191. 1350 poke781,v+j:poke782,20:sysss:print"        ";
  192. 1360 return
  193. 1365 :
  194. 1370 rem *****************************
  195. 1372 rem *                           *
  196. 1374 rem *    move st$ & inverses a$ *
  197. 1376 rem *                           *
  198. 1378 rem *****************************
  199. 1379 :
  200. 1380 poke781,v+i-3:poke782,33:sysss:print"       "
  201. 1390 poke781,v+i-2:poke782,33:sysss:print"storage";
  202. 1400 poke781,v+i-1:poke782,29:sysss:print"           ";
  203. 1410 print"";
  204. 1420 poke781,v+i:poke782,40-len(st$):sysss:print""st$
  205. 1430 ifpfl=0thenpoke781,v+i:poke782,4:sysss:print""i;"[146][157]  ";a$(i):goto1460
  206. 1440 poke781,v+i:poke782,2:sysss:print"a$(i)=";tab(8);a$(i)
  207. 1450 ifpfl=1thenpoke781,5:poke782,17:sysss:print""i
  208. 1460 print"[146]"
  209. 1470 return
  210. 1475 :
  211. 1480 rem ******************************
  212. 1482 rem *                            *
  213. 1484 rem * inverse, pause & normal p$ *
  214. 1486 rem *                            *
  215. 1488 rem ******************************
  216. 1489 :
  217. 1490 print"";
  218. 1500 ifpfl=1andi=1andnuloop=1thenpoke781,17:poke782,1:sysss:printp$(1)
  219. 1510 ifpfl=1andi<>1andnuloop=1thenpoke781,24:poke782,1:sysss:printp$(8);
  220. 1520 print"[146]";
  221. 1530 iftfl<>0andnuloop=1thenpa=50:gosub 1160
  222. 1540 ifpfl=1andi=1andnuloop=1thenpoke781,17:poke782,1:sysss:printp$(1)
  223. 1550 ifpfl=1andi<>1andnuloop=1thenpoke781,24:poke782,1:sysss:printp$(8);
  224. 1560 return
  225. 1565 :
  226. 1570 rem ******************************
  227. 1572 rem *                            *
  228. 1574 rem *   inverse for a$(j), p$    *
  229. 1576 rem *                            *
  230. 1578 rem ******************************
  231. 1579 :
  232. 1580 print"":poke783,peek(783)and254
  233. 1590 ifpfl=0thenpoke783,peek(783)and254
  234. 1595 ifpfl=0thenpoke781,v+j:poke782,4:sysss:print""j;"[146][157]  ";a$(j):goto1610
  235. 1600 poke781,v+j:poke782,2:sysss:print"a$(j)=";tab(8);""a$(j)
  236. 1610 ifpfl=1andnuloop=1thenpoke781,18:poke782,1:sysss:print""p$(2)
  237. 1620 ifpfl=1andnuloop=0thenpoke781,23:poke782,1:sysss:print""p$(7);
  238. 1630 ifpfl=1andnuloop=1thenpoke781,5:poke782,25:sysss:print""
  239. 1640 ifpfl=1andnuloop=0thenpoke781,5:poke782,25:sysss:print""j
  240. 1650 print"[146]"
  241. 1660 iftfl<>0thenpa=50:gosub1160
  242. 1670 gosub 390
  243. 1680 ifpfl=1andnuloop=0thenpoke781,23:pok